perm filename SEG.SAI[8,ALS]1 blob
sn#041481 filedate 1973-05-16 generic text, type T, neo UTF8
00010 BEGIN "SEGMENT"
00020 DEFINE ⊂="COMMENT"; ⊂ 5/14/73;
00030 ⊂ This program has been simplified for use in getting segmentation
00040 results for the workshop. All on line output has been removed. The
00050 progra handle utterances of almost any length altho there is only
00060 space for 100 segments of each of three classes;
00080
00090 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00100 REQUIRE "BLOCKS.HDR[SYS,THO]" SOURCE_FILE;
00110 REQUIRE "SIG" LOAD_MODULE;
00120 EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00130 EXTERNAL STRING PROCEDURE INCHWL;
00140 EXTERNAL PROCEDURE SPOOL(STRING S; INTEGER IOCHAN,FLAGS);
00150 DEFINE BUFSIZ="1024",CNTSIZ="100";
00180 STRING TFILEI,FILEI,OPT1;
00190 INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00200 INTEGER ARRAY LFILE[0:'177];
00210 INTEGER CHAN4,CHAN6,EOF,IEOF,FILEC;
00220 INTEGER BPT,SEGCNT,SEGTOT,H,I,J,K,L,Q;
00235 INTERNAL INTEGER M,N,P,RATE,FLAG,SEGC,INTOT,HINT,TFLAG,UPCNT;
00280 LABEL START,LABELA,LABELB,ZZZZ,FINISH;
00290 INTEGER ARRAY LEV1,LEV2,LEV3,LEV4,SEG1,SEG2,SEG3,SEG4[0:CNTSIZ];
00300 INTEGER CON1,CON2,CON3,CON4;
00310
00330 DEFINE ⊂="COMMENT",CR="'15",LF="'12",FF="'14",TB="'11";
00340 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
00350 DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
00360
00370 INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
00380 BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
00390 BOOLEAN NF;
00400 LOOKUP(CHAN,FILENAME,NF);
00410 WHILE NF DO
00420 BEGIN
00430 OUTSTR(CR&LF&"Can't find "&FILENAME&". try [1,VIN], File=");
00440 FILENAME ← INCHWL ;
00450 LOOKUP(CHAN,FILENAME,NF)
00460 END;
00470 END "LOOKIN";
00500
00510 PROCEDURE REPORT;
00520 BEGIN "REP"
00530 STRING LAB; INTEGER OUT,I,J,K,L;
00540 IF TFLAG≠0 THEN BEGIN
00550 TFLAG←0;
00560 FOR I←0 STEP 5 UNTIL TBLSIZ DO BEGIN
00570 IF TABLET[I+1]=0 THEN DONE ELSE
00580 IF (LDB(POINT(2,TABLET[I+2],12)))>0 THEN BEGIN "CT"
00590 LAB←CVXSTR(TABLET[I+1]); OUT←TABLET[I] ;
00600 IF LDB(POINT(3,TABLET[I],20))-1 < LDB(POINT(3,TABLET[I+2],3)) THEN BEGIN
00620 TABLET[I+2]←TABLET[I+2] LAND '770000000000; DONE END;
00650 IF EQU(LAB,"VOICED")∨EQU(LAB,"FRIC ")∨EQU(LAB,"VOIFRI")
00660 ∨EQU(LAB,"VS ")∨EQU(LAB,"SI ") THEN
00670
00680 BEGIN LEV1[CON1]←TABLET[I+1]; SEG1[CON1]←OUT;
00690 IF CON1<CNTSIZ THEN CON1←CON1+1 ELSE OUTSTR("Level 1 overflow"); END
00700
00710 ELSE IF
00720 EQU(LAB,"SCHWA ")∨EQU(LAB,"NASAL ")∨EQU(LAB,"GLIDE ")∨EQU(LAB,"VOWEL ")
00730 THEN
00740 BEGIN LEV2[CON2]←TABLET[I+1]; SEG2[CON2]←OUT;
00750 IF CON2<CNTSIZ THEN CON2←CON2+1 ELSE OUTSTR("Level 2 overflow"); END
00760
00770 ELSE IF EQU(LAB,"S/T ")∨EQU(LAB,"SH/K ")∨EQU(LAB,"F/P ") THEN
00780 BEGIN LEV3[CON3]←TABLET[I+1]; SEG3[CON3]←OUT;
00790 IF CON3<CNTSIZ THEN CON3←CON3+1 ELSE OUTSTR("Level 3 overflow"); END
00800
00810 ELSE BEGIN LEV4[CON4]←TABLET[I+1]; SEG4[CON4]←OUT;
00820 IF CON4<CNTSIZ THEN CON4←CON4+1 ELSE OUTSTR("Level 4 overflow"); END;
00830 TABLET[I+2]←TABLET[I+2] LAND '770000000000; END "CT"; END; END;
00840 END "REP";
00850
00860 PROCEDURE ORDER;
00870 BEGIN "ORDER"
00880 INTEGER I,J,K;
00890 FOR I←0 STEP 1 UNTIL CON1-2 DO
00900 FOR J←I STEP 1 UNTIL CON1-2 DO
00910 IF LDB(POINT(15,SEG1[J+1],17))<LDB(POINT(15,SEG1[J],17)) THEN
00920 BEGIN K←LEV1[J+1]; LEV1[J+1]←LEV1[J]; LEV1[J]←K;
00930 K←SEG1[J+1]; SEG1[J+1]←SEG1[J]; SEG1[J]←K; END;
00940 FOR I←0 STEP 1 UNTIL CON2-2 DO
00950 FOR J←I STEP 1 UNTIL CON2-2 DO
00960 IF LDB(POINT(15,SEG2[J+1],17))<LDB(POINT(15,SEG2[J],17)) THEN
00970 BEGIN K←LEV2[J+1]; LEV2[J+1]←LEV2[J]; LEV2[J]←K;
00980 K←SEG2[J+1]; SEG2[J+1]←SEG2[J]; SEG2[J]←K; END;
00990 FOR I←0 STEP 1 UNTIL CON3-2 DO
01000 FOR J←I STEP 1 UNTIL CON3-2 DO
01010 IF LDB(POINT(15,SEG3[J+1],17))<LDB(POINT(15,SEG3[J],17)) THEN
01020 BEGIN K←LEV3[J+1]; LEV3[J+1]←LEV3[J]; LEV3[J]←K;
01030 K←SEG3[J+1]; SEG3[J+1]←SEG3[J]; SEG3[J]←K; END;
01040
01050 FOR I←0 STEP 1 UNTIL CON4-2 DO
01060 FOR J←I STEP 1 UNTIL CON4-2 DO
01070 IF LDB(POINT(15,SEG4[J+1],17))<LDB(POINT(15,SEG4[J],17)) THEN
01080 BEGIN K←LEV4[J+1]; LEV4[J+1]←LEV4[J]; LEV4[J]←K;
01090 K←SEG4[J+1]; SEG4[J+1]←SEG4[J]; SEG4[J]←K; END;
01100 END "ORDER";
00010 FILEI←"SEG1.T0[77,THO]"; UPCNT←3; OPT1←"N"; FILEC←0; CHAN4←4; CHAN6←6;
00040 TABIN(INTOT);
00050 IF STRIN("Should old TELL.DOC be spooled YorN = ")="Y" THEN BEGIN
00060 OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF); LOOKUP(CHAN6,"TELL.DOC",0);
00080 RENAME(CHAN6,"TELL.OLD",0,EOF); CLOSE(CHAN6);
00100 SPOOL("TELL.OLD",GETCHAN,1); END;
00120
00130 ⊂ **** MAIN ROUTINE STARTS HERE****;
00140 START: CLOSE(CHAN6);
00160 IF OPT1≠"Y" THEN
00170 IF (TFILEI←STRIN("Data file FFT/LPC ("&FILEI&")="))≠"" THEN FILEI←TFILEI
00180 ELSE OPT1←"Y";
00190 IF OPT1="Y" THEN BEGIN FILEC←FILEC+1; SETFORMAT(1,0);
00210 FILEI←"SEG"&CVS(FILEC)&".T0[77,THO]";
00220 OUTSTR("Starting on "&FILEI&CRLF); END;
00250
00260 FOR I←0 STEP 5 UNTIL TBLSIZ-5 DO IF TABLET[I+1]=0 THEN DONE
00270 ELSE BEGIN TABLET[I+2]←TABLET[I+2] LAND '770000000000;
00280 TABLET[I+3]←0; END; ⊂ INITIALISE FOR EVENT;
00290 FOR I←0 STEP 1 UNTIL CNTSIZ DO BEGIN LEV1[I]←LEV2[I]←LEV3[I]←LEV4[I]←0;
00300 SEG1[I]←SEG2[I]←SEG3[I]←SEG4[I]←0; END;
00310 CON1←CON2←CON3←CON4←0; CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00340 LOOKIN(CHAN4,FILEI); EOF←SEGC←SEGCNT←0;
00360 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
00370 SEGTOT←(LFILE[0])*3%128; RATE←LFILE[2];
00375 OUTSTR("Segtot="&CVS(SEGTOT)&" Words="&CVS(LFILE[0])&CRLF);
00380 OUTSTR("Sampling rate="&CVS(LFILE[2])&CRLF);
00390 IF RATE=0 THEN RATE←CVD(STRIN("Sampling rate missing. Rate = "));
00400
00420 OPEN(CHAN6,"DSK",0,2,'10,0,0,EOF); LOOKUP(CHAN6,"TELL.DOC",0);
00440 DEFINE UGETF="'073000000000"; START_CODE; UGETF 6,I; END;
00480 ENTER(CHAN6,"TELL.DOC",0); USETO(CHAN6,I); OUT(CHAN6,FF);
00510 OUT(CHAN6,TB&TB&TB&" A.I. Laboratory"&CRLF&TB&TB&TB&"Stanford University"
00520 &CRLF&LF&"Segmentation data for ARPA Speech Segmentation Workshop"&CRLF);
00530 OUT(CHAN6," SEG# in file name refers to the Utterance Number."&CRLF);
00540 OUT(CHAN6,CRLF&"Data file "&FILEI&" "&TB&TB&DATIME&CRLF);
00570 SETFORMAT(5,0);
00590
00600 LABELA: ⊂ Put all outputs into the off state;
00610 FOR I←0 STEP 5 UNTIL TBLSIZ-5 DO
00620 IF TABLET[I+1]≠0 THEN TABLET[I]←'777777777777 ELSE DONE;
00630 CON1←CON2←CON3←CON4←0; HINT←H←0; TABLES[2]←HLIST[0];
00640
00650 WHILE EOF=0 DO BEGIN "DATAIN"
00660 ARRYIN(CHAN4,DATBUF[0],BUFSIZ); ⊂ Get data;
00670 BPT←POINT(6,DATBUF[0],-1);
00680
00690 FOR Q←1 STEP 1 UNTIL BUFSIZ%4 DO BEGIN
00700 SEGC←SEGC+1;
00710 IF SEGC>SEGTOT THEN DONE;
00720 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
00730 LABELB: SIG(P); REPORT;
00750 END;
00760 IF SEGC>SEGTOT THEN DONE;
00770 END "DATAIN"; CLOSE(CHAN4);
00780
00790 FOR I←0 STEP 1 UNTIL INSIZ-1 DO INDAT[I]←0;
00800 FOR I←0 STEP 1 UNTIL 4 DO BEGIN SEGC←SEGC+1; SIG(P); REPORT; END;
00830
00840 ⊂ **** Off line listing of counter outputs ****;
00850 ORDER;
00860 OUT(CHAN6,CRLF&
00870 "In CMU units SEG."&TB&" Levels"&TB&" In units of 6.4 ms.");
00880 OUT(CHAN6,CRLF&"Begin"&TB&" End "
00890 &TB&"Label"&TB&" Ave."&TB&"Max. "&TB&"Begin"&TB&" End"
00900 &TB&"Count"&CRLF);
00910 OUT(CHAN6,CRLF&
00920 "First level [voiced, fric., voiced-stop, stop]"
00930 &CRLF);
00940 FOR I←0 STEP 1 UNTIL CON1-1 DO BEGIN
00950 J←LDB(POINT(15,SEG1[I],17)); K←LDB(POINT(15,SEG1[I],35)); L←J+K-1;
00970 OUT(CHAN6,CRLF&CVS(J LSH 6)&TB&CVS((L) LSH 6)&TB
00980 &CVXSTR(LEV1[I])&TB&CVS(LDB(POINT(3,SEG1[I],2)))
00990 &CVS(LDB(POINT(3,SEG1[I],20)))&TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
01010 OUT(CHAN6,CRLF&LF& "Voiced [vowel, glide, nasal]"&CRLF);
01020
01030 FOR I←0 STEP 1 UNTIL CON2-1 DO BEGIN
01040 J←LDB(POINT(15,SEG2[I],17)); K←LDB(POINT(15,SEG2[I],35)); L←J+K-1;
01060 OUT(CHAN6,CRLF&CVS(J LSH 6)&TB&CVS(L LSH 6)&TB
01070 &CVXSTR(LEV2[I])&TB&CVS(LDB(POINT(3,SEG2[I],2)))
01080 &CVS(LDB(POINT(3,SEG2[I],20)))&TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
01110 OUT(CHAN6,CRLF&LF&"Fricatives [S/T, SH/K, F/P]"&CRLF);
01120
01130 FOR I←0 STEP 1 UNTIL CON3-1 DO BEGIN
01140 J←LDB(POINT(15,SEG3[I],17)); K←LDB(POINT(15,SEG3[I],35)); L←J+K-1;
01160 OUT(CHAN6,CRLF&CVS(J LSH 6)&TB&CVS(L LSH 6)
01170 &TB&CVXSTR(LEV3[I])&TB&CVS(LDB(POINT(3,SEG3[I],2)))&
01180 CVS(LDB(POINT(3,SEG3[I],20)))&TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
01190 OUT(CHAN6,CRLF&LF&"Vowels [front, mid, back]"&CRLF);
01200 FOR I←0 STEP 1 UNTIL CON4-1 DO BEGIN
01210 J←LDB(POINT(15,SEG4[I],17)); K←LDB(POINT(15,SEG4[I],35)); L←J+K-1;
01230 OUT(CHAN6,CRLF&CVS(J LSH 6)&TB&CVS(L LSH 6)
01240 &TB&CVXSTR(LEV4[I])&TB&CVS(LDB(POINT(3,SEG4[I],2)))&
01250 CVS(LDB(POINT(3,SEG4[I],20)))&TB&CVS(J)&TB&CVS(L)&TB&CVS(K)); END;
01280 OUT(CHAN6,CRLF); CLOSE(CHAN6);
01290
01340 GO TO START;
01360 FINISH:
01370 END "SEGMENT";